home *** CD-ROM | disk | FTP | other *** search
/ Mac Power 1997 January / macpower199701.bin / AMUG / Publishing_19 / Alpha 6.5.sit / Tcl / Modes / bibtex.tcl < prev    next >
Encoding:
Text File  |  1996-08-15  |  43.2 KB  |  1,406 lines  |  [TEXT/ALFA]
  1. ###########################################################################
  2. # bibtex.tcl
  3. # 
  4. # This file contains a package of Tcl routines that add support for using
  5. # and maintaining BibTeX citation databases to Alpha. 
  6. #
  7. # See the accompanying file, "BibTeX Help", for a complete description.
  8. # (Unfortunately, it's a bit out of date right now - stay tuned (WTP 6/95))
  9. # 
  10. ###########################################################################
  11. # Notes: 
  12. # 
  13. # By default, only the required fields are included when a new bib entry 
  14. # is created.  You can select any other set of fields to be used by adding 
  15. # an appropriate entry to the 'myFld' array, following the example for the 
  16. # Article entry, further below.  You shouldn't change the 'rqdFld' or 
  17. # 'optFld' arrays, since these will (some day) be used for syntax checking.
  18. # 
  19. ###########################################################################
  20. # written by Tom Pollard (pollard@cucbs.chem.columbia.edu)
  21. #
  22. # Version History
  23. #
  24. # 2.7  (7/95)   'stdAbbrevs' modeVar added for setting predefined abbrevs
  25. #               month names included as predefined abbrevs
  26. #               'alignEquals' formatting flag added.
  27. # 2.62 (7/95)   field delimiters suppressed if field data is an abbreviation
  28. #               unindexed .bib files are indexed automatically upon opening
  29. # 2.61 (7/95)   fixed "SearchFields" bug.
  30. # 2.6  (6/95)   'zapEmptyFields' flag forces optional fields to be removed 
  31. #                   when reformatting an entry.
  32. #               'markStrings' flag controls whether @string entries are included in 
  33. #                   the marks menu.
  34. #               'descendingYears' flag controls whether sorts are in ascending or 
  35. #                   descending chronological order.
  36. #               Sorts all use the year as either primary or secondary sort key now.
  37. #               'copyCiteKey' command copies the citekey of the current entry to the
  38. #                   clipboard.
  39. #               Cmd-double-clicking implemented to resolve abbreviations and crossrefs.
  40. #               Fixed bug in faster getFields proc (comma-after-last-field problems)  
  41. #               Fixed minor bugs in author sorting.  
  42. # 2.5  (6/95)   Fixed bug in formatEntry, whereby '#' concatenations were lost 
  43. #               formatEntry completely ignores @string entries now
  44. #               Entry-parsing code (getFields, getFldVal) cleaned up,
  45. #                  should also be a little bit faster now.
  46. #               formatAllEntries now starts working from the current entry
  47. # 2.41 (6/95)   Updates for compatibility with revised LaTeX mode
  48. #               Automatic conversion of international characters dropped 
  49. #                   (irreconcilable problems with non-US keyboards).
  50. # 2.4  (5/95)   Fixed bugs in parsing of EndNote-created bib files
  51. # 2.3  (4/95)   International characters converted to TeX codes (optionally).
  52. #               'findEntries' bug fixed (no longer returns multiple hits) 
  53. # 2.2 (12/94)   'formatEntries' won't quote fields that contain "#".
  54. #               'segregateStrings' flag forces string defs to sort to the top.
  55. # 2.11(12/94)   Bug fixes in 'formatAllEntries'.
  56. # 2.1 (12/94)   'countEntries' command added.
  57. #               'formatAllEntries' command added; it's a bit clunky, but more robust
  58. #                   than any quicker alternative I considered.
  59. #               Cross-referenced entries now sort to the bottom in all sorts.
  60. #                'crossref' field now included.
  61. # 2.0  (9/94)   'formatEntry' and 'newEntry' line up fields better.
  62. #                'nextEntry' and 'prevEntry' skip @string defs
  63. #                'formatEntry' automtically goes to next entry afterwards.
  64. #                'sortByCitekey' ignores case of cite keys.
  65. #               'fillColumn' included as default modeVar.
  66. #                'getEntry' alerts user to badly delimited entries.
  67. # 1.9 (9/94)    'getFields' should now correctly parse any legal entry.
  68. #                'language' field now included.
  69. #                Default values for new fields (eg 'language') may be defined
  70. #                'preferBraces' replaced by 'fieldBraces' and 'entryBraces'.
  71. #                line-wrapping is done on reformatted entries.
  72. #                '@string' entries preserved in sorts.
  73. #                text before first entry and after last entry are preserved
  74. #                    by sorts.
  75. # 1.8 (8/94)    "getEntry" now recognizes parens as entry delimiters
  76. # 1.7 (8/94)    Bug fixes and accomodations to latex.tcl v2.2
  77. #               Template insertion streamlined
  78. #                Choose multiple fields at a time from list dialog
  79. # 1.6 (8/94)    "preferBraces" allows braces or quotes to be default for
  80. #                   new or reformatted entries,
  81. #               Menu built using $entryNames and $fieldNames,
  82. #               'sortByAuthors' can now sort using last author first,
  83. #                   and is a bit faster,
  84. #               'formatEntry' rewrites entries in canonical format,
  85. #               More customization of canonical format allowed ('indentString')
  86. #               Bib mode definition adapted to Alpha 5.90.
  87. # 1.5 (7/94)    "sortByAuthors" is now robust (I think),
  88. #               Mode of new windows now set correctly.
  89. # 1.4 (7/94)    Added sorting by authors, but still only semi-functional,
  90. #               Added regexp searching by field,
  91. #               "getEntry" bugs fixed.
  92. # 1.2 (7/94)    Bib mode definition adapted to Alpha 5.85,
  93. #               Added bib-file marking (bibMarkFile),
  94. #               Entry and field creation now controlled by data arrays.
  95. # 1.1 (6/94)    Custom BibTeX icon, 
  96. #               Added simple search capability (matchingEntries).
  97. # 1.0 (9/93)    First stable version.
  98. #
  99. ###########################################################################
  100. # This package was inspired by the LaTeX package (latex.tcl), written by
  101. # 
  102. #    Richard T. Austin  <austin@eecs.umich.edu>  , and (currently),
  103. #    Tom Scavo          <trscavo@syr.edu>
  104. #
  105. ###########################################################################
  106. ############################################################################
  107. # Cause latex.tcl to be loaded by calling a dummy procedure defined in that
  108. # file.  This is necessary to get the TeX menu, and to load the 8-bit ASCII
  109. # to TeX conversion routines.
  110. #
  111. dummyTeX
  112.  
  113. ###########################################################################
  114. # BibTeX Key Bindings.
  115. ###########################################################################
  116. # abbreviations:  <o> = option, <z> = control, <s> = shift, <c> = command
  117. #
  118. bind 'b' <sz>    selectEntry "Bib"
  119. bind 'n' <sz>    nextEntry "Bib"
  120. bind 'p' <sz>    prevEntry "Bib"
  121.  
  122. bind 'f' <sz>    searchFields "Bib"
  123. bind 'm' <sz>    searchEntries "Bib"
  124. bind 'l' <sz>    formatEntry "Bib"
  125.  
  126. # tab stops:
  127. bind    '¥t'    nextTabStop    "Bib"
  128. bind    '¥t'    <s>     prevTabStop    "Bib"
  129. bind  '¥t'  <z>  {nthTabStop 0}  "Bib"
  130. bind  '¥t'  <c>  deleteTabStops  "Bib"
  131.  
  132. ###########################################################################
  133. # Data Definitions
  134. ###########################################################################
  135. ###########################################################################
  136. # Define the data arrays that contain the names of the required,
  137. # optional, and preferred fields for each entry type.
  138. #
  139. # The index names of the rqdFld() array _define_ the valid entry types
  140. # recognized by the program.
  141. #
  142. set rqdFld(article) {author title journal year} 
  143. set optFld(article) {volume number pages month note}
  144. set myFld(article) {author title journal volume pages year note} 
  145.  
  146. set rqdFld(book) {author title publisher year} 
  147. set optFld(book) {editor volume number series address edition month note}
  148.  
  149. set rqdFld(booklet) {title} 
  150. set optFld(booklet) {author howpublished address month year note}
  151.  
  152. set rqdFld(conference) {author title booktitle year} 
  153. set optFld(conference) {editor volume number series pages organization publisher address month note}
  154.  
  155. set rqdFld(inBook) {author title chapter publisher year} 
  156. set optFld(inBook) {editor pages volume number series address edition month type note}
  157.  
  158. set rqdFld(inCollection) {author title booktitle publisher year} 
  159. set optFld(inCollection) {editor volume number series type chapter pages address edition month note}
  160.  
  161. set rqdFld(inProceedings) {author title booktitle year} 
  162. set optFld(inProceedings) {editor volume number series pages organization publisher address month note}
  163.  
  164. set rqdFld(manual) {title} 
  165. set optFld(manual) {author organization address edition year month note}
  166.  
  167. set rqdFld(mastersThesis) {author title school year} 
  168. set optFld(mastersThesis) {address month note type}
  169.  
  170. set rqdFld(misc) {} 
  171. set optFld(misc) {author title howpublished year month note}
  172.  
  173. set rqdFld(phdThesis) {author title school year} 
  174. set optFld(phdThesis) {address month type note}
  175.  
  176. set rqdFld(proceedings) {title year} 
  177. set optFld(proceedings) {editor volume number series publisher organization address month note}
  178.  
  179. set rqdFld(techReport) {author title institution year} 
  180. set optFld(techReport) {type number address month note}
  181.  
  182. set rqdFld(unpublished) {author title note} 
  183. set optFld(unpublished) {year month}
  184.  
  185. set entryNames [lsort [array names rqdFld]]
  186. set customEntries [lsort [array names myFld]]
  187.  
  188. ###########################################################################
  189. # Define an array of flags indicating whether the data a given field
  190. # type should be quoted.  The actual characters used to quote the field are
  191. # given by $bibOpenQuote and $bibCloseQuote, which are set by the routine
  192. # 'bibFieldDelims' according to the flag $fieldBraces.
  193. #
  194. # Note that the index names of the useBrace() array _define_ the valid 
  195. # field types recognized by the program.
  196. #
  197. set useBrace(address)    1
  198. set useBrace(annote)    1
  199. set useBrace(author)     1
  200. set useBrace(booktitle)    1
  201. set useBrace(chapter)    0
  202. set useBrace(crossref)    1
  203. set useBrace(edition)    1
  204. set useBrace(editor)    1
  205. set useBrace(howpublished)    1
  206. set useBrace(institution)    1
  207. set useBrace(journal)    1
  208. set useBrace(key)    1
  209. set useBrace(language)    1
  210. set useBrace(month)    1
  211. set useBrace(note)    1
  212. set useBrace(number)    0
  213. set useBrace(organization)    1
  214. set useBrace(pages)    0
  215. set useBrace(publisher)    1
  216. set useBrace(school)    1
  217. set useBrace(series)    1
  218. set useBrace(title)    1
  219. set useBrace(type)    1
  220. set useBrace(volume)    0
  221. set useBrace(year)    0
  222.  
  223. set fieldNames [lsort [array names useBrace]]
  224. ###########################################################################
  225. # Default values for newly created fields
  226. #
  227. set defFldVal(language) "german"
  228.  
  229. set fieldDefs [lsort [array names defFldVal]]
  230.  
  231. ###########################################################################
  232. # Search patterns for entries and cite-keys
  233. #
  234. #     set bibTopPat {^[     ]*@[a-zA-Z]+[¥{¥(]([-A-Za-z0-9_:/¥.]+)}
  235. # match entry type
  236. set bibTopPat {^[     ]*@([a-zA-Z]+)[¥{¥(]}
  237. # match cite-key
  238. set bibTopPat1 {^[     ]*@[a-zA-Z]+[¥{¥(][     ]*([^=,     ]+)}    
  239. # match type and cite-key
  240. set bibTopPat2 {^[     ]*@([a-zA-Z]+)[¥{¥(][     ]*([^=,     ]+)}    
  241. # match first field (no cite-key)
  242. set bibTopPat3 {^[     ]*@([a-zA-Z]+)[¥{¥(]([     ]*[a-zA-Z]+[     ]*=[     ]*)}    
  243.                                                                 
  244.  
  245. ###########################################################################
  246. # BibTeX-mode mode definition
  247. ###########################################################################
  248. newModeVar Bib suffixString    { ¥¥¥¥} 0
  249. newModeVar Bib prefixString    {% } 0
  250. newModeVar Bib fillColumn    {65} 0
  251. newModeVar Bib wordWrap        {0} 1
  252. newModeVar Bib autoMark        {1} 1
  253.  
  254. newModeVar Bib wordBreak         {[a-zA-Z0-9]+} 0
  255. newModeVar Bib wordBreakPreface     {[^a-zA-Z0-9]} 0
  256. newModeVar Bib funcExpr           $bibTopPat 0
  257.  
  258. newModeVar Bib overwriteBuffer {1} 1
  259. newModeVar Bib fieldBraces {1} 1
  260. newModeVar Bib entryBraces {1} 1
  261. newModeVar Bib segregateStrings {1} 1
  262. newModeVar Bib markStrings {0} 1
  263. newModeVar Bib alignEquals {0} 1
  264. ###
  265. # newModeVar Bib emacsBibMode {0} 1
  266. # newModeVar Bib addCiteKeys {0} 1
  267. # newModeVar Bib checkSyntax {0} 1
  268. newModeVar Bib zapEmptyFields {0} 1
  269. newModeVar Bib descendingYears {1} 1
  270. ###
  271. newModeVar Bib indentString {   } 0
  272. newModeVar Bib stdAbbrevs {jan feb mar apr may jun jul aug sep oct nov dec} 0
  273. # newModeVar Bib convert8bitAscii2TeX {0} 1
  274.  
  275. set bibtexKeyWords {address annote author booktitle 
  276.     chapter city crossref edition editor howpublished institution 
  277.     journal key language month note number organization 
  278.     publisher pages school series title type 
  279.     volume year}
  280. regModeKeywords -e {%} -m {@} -c red -k blue Bib $bibtexKeyWords
  281. unset bibtexKeyWords
  282.  
  283. # # Use a shadow proc to keep settings for 8-bit character conversion 
  284. # # consistent between TeX and Bib modes. 
  285. # #
  286. # trace variable BibmodeVars(convert8bitAscii2TeX) w shadowBib8bitConvert
  287. # proc shadowBib8bitConvert {name1 name2 op} {
  288. #     global BibmodeVars TeXmodeVars
  289. # 
  290. #     # Use TeX-mode routines to actually do the key bindings. 
  291. #     #
  292. #     if {$BibmodeVars(convert8bitAscii2TeX)} then {
  293. #         toggle8bitAscii "ascii" "Bib"
  294. #     } else {
  295. #         toggle8bitAscii "unascii" "Bib"
  296. #     }
  297. #     
  298. #     # Only set TeX flag if necessary, to avoid unnecessary rebinding of keys
  299. #     # (It takes enough time to be annoying)
  300. #     #
  301. #     if {$BibmodeVars(convert8bitAscii2TeX) != $TeXmodeVars(convert8bitAscii2TeX)} then {
  302. #         set TeXmodeVars(convert8bitAscii2TeX) $BibmodeVars(convert8bitAscii2TeX)
  303. #     }
  304. # }
  305. # 
  306. # set BibmodeVars(convert8bitAscii2TeX) $TeXmodeVars(convert8bitAscii2TeX)
  307.  
  308. ###########################################################################
  309. # BibTeX Menu Definition.
  310. ###########################################################################
  311. proc bibtexMenu {} {}
  312.  
  313. set bibtexMenu "･136"
  314.  
  315. proc bibtex {} {
  316.     global bibtexSig
  317.     set name [launchBackApplSigs {BIBt Vbib} bibtexSig]
  318.     switchTo [file tail $name]
  319. }
  320.  
  321. proc makeindex {} {
  322.     launchForeAppl Midx
  323. }
  324.  
  325. menu -n $bibtexMenu {
  326.     "bibtex"
  327.     "(-)"  
  328.     {menu -n Entries -p makeEntry {}
  329.     }
  330.     {menu -n Fields -p makeField {}
  331.     }
  332.     "(-)"
  333.     "selectEntry/B<U<B"
  334.     "nextEntry/N<U<B"
  335.     "prevEntry/P<U<B"
  336.     "formatEntry/L<U<B"
  337.     "copyCiteKey/C<U<B"
  338.     "(-)"
  339.     "searchEntries/M<U<B"
  340.     "searchFields/F<U<B"
  341.     {menu -n sortBy... -p bibSortProc {
  342.         "citeKey"
  343.         "firstAuthor,Year"
  344.         "lastAuthor,Year"
  345.         "year,FirstAuthor"
  346.         "year,LastAuthor"
  347.         }
  348.     }
  349.     {menu -n sortMarks... -p markSortProc {
  350.         "alphabetically"
  351.         "byPosition"
  352.         }
  353.     }
  354.     "(-)"
  355.     "countEntries"
  356.     "formatAllEntries"
  357. } 
  358.     
  359. menu -n Entries -p makeEntry [concat $entryNames {
  360.         "(-)"
  361.         "customEntry"
  362.         } ]
  363.  
  364. menu -n Fields -p makeField [concat $fieldNames {
  365.         "(-)"
  366.         "customField"
  367.         "multipleFields"
  368.         } ]
  369.         
  370. ###########################################################################
  371. # Menu command procs
  372. ###########################################################################
  373.         
  374. proc makeField {menu item} {
  375.     global fieldNames
  376.     bibFormatSetup
  377.     
  378.     if {$item == "multipleFields"} then {
  379.         set flds [listpick -l -L {author year} -p "Pick desired fields:" $fieldNames]
  380.         if {[llength flds]} {
  381.             set lines {}
  382.             foreach fld $flds {
  383.                 append lines [newField $fld]
  384.             }
  385.         } else {
  386.             return
  387.         }
  388.     } else {
  389.         set lines [newField $item]
  390.     }
  391.     
  392.     set pos0 [nextLineStart [getPos]]
  393.     goto $pos0
  394.     insertText $lines
  395.     goto $pos0
  396.     nextTabStop
  397. }
  398.  
  399. proc makeEntry {menu item} {
  400.     bibFormatSetup
  401.     newEntry $item
  402. }
  403.  
  404. ###########################################################################
  405. #  Return the bounds of the bibliographic entry surrounding the current 
  406. #  position.
  407. #
  408. proc getEntry {pos} {
  409.     
  410.      set pos1 [search -f 0 -r 1 -n -s {[     ]*@[a-zA-Z]*[¥{¥(]} $pos ]
  411.     if {$pos1 == ""} then {
  412.         set begPos [nextLineStart $pos]
  413.         set endPos $begPos
  414.     } else {
  415.         set begPos [lineStart [lindex $pos1 0]]
  416.         set pos0 [lindex $pos1 1]
  417.         set openBrace [getText [expr $pos0-1] $pos0 ]
  418.         if {[catch {matchIt $openBrace $pos0]} pos1]} {
  419.             alertnote "There seems to be a badly delimited field in here.  Are entry and field delimiters set correctly?"
  420.             goto $begPos
  421.             error "Can't find close brace"
  422.         } else {
  423.             set endPos [nextLineStart $pos1]
  424.         }
  425.     }
  426.     return [list $begPos $endPos]
  427. }
  428.  
  429. ###########################################################################
  430. #  Advance to the next bibliographic entry.
  431. #
  432. proc nextEntry {} {
  433.     global bibTopPat bibTopPat1 bibTopPat2
  434. #     set topPat {[     ]*@([a-zA-Z]+)[¥{¥(]}
  435.     
  436.     set pos0 [lindex [getEntry [getPos]] 1]
  437.     set nextPos [nextLineStart $pos0]
  438.     
  439.     while {![catch {search -f 1 -r 1 -s $bibTopPat $pos0} pos]} {
  440.         regexp $bibTopPat [eval getText $pos] mtch type
  441.         if {$type != "string"} {
  442.             set nextPos [lindex $pos 0]
  443.             break
  444.         } else {
  445.             set pos0 [nextLineStart [lindex $pos 1]]
  446.         }
  447.     }
  448.     goto $nextPos
  449. }
  450.  
  451. ###########################################################################
  452. #  Go back to the previous bibliographic entry.
  453. #
  454. proc prevEntry {} {
  455.     global bibTopPat bibTopPat1 bibTopPat2
  456. #     set topPat {[     ]*@([a-zA-Z]+)[¥{¥(]}
  457.     
  458.     set pos0 [lindex [getEntry [getPos]] 0]
  459.     if {$pos0 > 0} {
  460.         set nextPos $pos0
  461.         incr pos0 -1
  462.         while {![catch {search -f 0 -r 1 -s $bibTopPat $pos0} pos]} {
  463.             regexp $bibTopPat [eval getText $pos] mtch type
  464.             if {$type != "string"} {
  465.                 set nextPos [lindex $pos 0]
  466.                 break
  467.             } else {
  468.                 set pos0 [lineStart [lindex $pos 0]]
  469.                 if {$pos0 == 0} {break}
  470.                 incr pos0 -1
  471.             }
  472.         }
  473.         goto $nextPos
  474.     }
  475. }
  476.  
  477. ###########################################################################
  478. #  Select (highlight) the current bibliographic entry.
  479. #
  480. proc selectEntry {} {
  481.     set pos [getEntry [getPos]]
  482.     select [lindex $pos 0] [lindex $pos 1]
  483. }
  484.  
  485. ###########################################################################
  486. #  Put the cite-key of the current entry on the clipboard.
  487. #
  488. proc copyCiteKey {} {
  489.     global bibTopPat2
  490.     set limits [getEntry [getPos]]
  491.     set top [lindex $limits 0]
  492.     set bottom [lindex $limits 1]
  493.     if {[regexp -indices $bibTopPat2 [getText $top $bottom] allofit type citekey]} {
  494.         select [expr $top+[lindex $citekey 0]] [expr $top+[lindex $citekey 1]+1]
  495.         copy
  496.         message "Copied ¥"[getSelect]¥""
  497.     } 
  498. }
  499.  
  500. ###########################################################################
  501. #  Create a new bibliographic entry with its required fields.
  502. #
  503. proc newEntry {entryName} {    
  504.     global  entryNames customEntries fieldNames rqdFld optFld myFld defFldVal
  505.     global bibOpenEntry bibCloseEntry BibmodeVars
  506.     goto [lindex [getEntry [getPos]] 1]
  507.     if {$entryName == "customEntry"} {
  508.         set lines "@･$bibOpenEntry･,¥r"
  509.         set theFields [listpick -l -L {author} -p "Pick desired fields:" $fieldNames]
  510.     } else {
  511.         set lines "@${entryName}$bibOpenEntry･,¥r"
  512.         if {[lsearch -exact $customEntries $entryName] >= 0 && [llength $myFld($entryName)]} {
  513.             set theFields $myFld($entryName)
  514.         } elseif {[lsearch -exact $entryNames $entryName] >= 0} {
  515.             set theFields $rqdFld($entryName)
  516.         } else {
  517.             set theFields {}
  518.         }
  519.     }
  520.     set nmlen 0
  521.     foreach field $theFields {
  522.         set len [string length $field]
  523.         if {$len > $nmlen} {set nmlen $len}        
  524.     }
  525.     set theTop [lineStart [getPos]]
  526.     foreach field $theFields {
  527.         catch {append lines [newField $field $nmlen]}
  528.     }
  529.     append lines "$bibCloseEntry¥r"
  530.     insertText $lines
  531.     goto $theTop
  532.     nextTabStop
  533. }
  534.  
  535. ###########################################################################
  536. #  Create a new field within the current bibliographic entry
  537. #
  538. proc newField {fieldName {nmlen 0}} {    
  539.     global fieldNames useBrace bibOpenQuote bibCloseQuote bibIndent
  540.     global fieldDefs defFldVal
  541.     set spc "                   "
  542.     if {[lsearch -exact $fieldNames $fieldName] >= 0} {
  543.         set needBraces $useBrace($fieldName)
  544.     } else {
  545.         set needBraces 1
  546.     }
  547.     
  548.     if {[lsearch -exact $fieldDefs $fieldName] >= 0} {
  549.         set val $defFldVal($fieldName)
  550.     } else {
  551.         set val "･"
  552.     }
  553.     
  554.     if {$nmlen} {
  555.         set pad [string range $spc 1 [expr $nmlen - [string length $fieldName]]]
  556.     } else {
  557.         set pad ""
  558.     }            
  559.     if {$needBraces || $fieldName == "customField"} {
  560.         set result "$bibIndent$fieldName =$pad ${bibOpenQuote}${val}${bibCloseQuote},¥r"
  561.     } else {
  562.         set result "$bibIndent$fieldName =$pad $val,¥r"
  563.     }    
  564.     return $result
  565. }
  566.  
  567. proc bibFormatSetup {} {
  568.     global bibOpenQuote bibCloseQuote bibIndent BibmodeVars
  569.     global bibOpenEntry bibCloseEntry bibAbbrevs
  570.     bibFieldDelims
  571.     bibEntryDelims
  572.     set bibIndent $BibmodeVars(indentString)
  573.     regsub {¥¥t} $bibIndent {    } bibIndent
  574.     set bibAbbrevs [listStrings]
  575.     foreach abbrev $BibmodeVars(stdAbbrevs) {
  576.         lappend bibAbbrevs [string tolower $abbrev]
  577.     }
  578. }
  579.  
  580. ###########################################################################
  581. #  Find all entries that match a given regular expression and copy them to 
  582. #  a new buffer.
  583. #
  584. proc searchEntries {} {
  585.     if [catch {prompt "Regular expression:" ""} reg] return
  586.     if {![string length $reg]} return
  587.     set reg ^.*$reg.*$
  588.     
  589.     set matches [findEntries $reg]
  590.     if {[llength $matches] >0} {
  591.         writeEntries $matches 0
  592.     } else {
  593.         message "No matching entries were found"
  594.     }
  595. }
  596.  
  597. ###########################################################################
  598. #  Find all entries in which the indicated field matches a given regular 
  599. #  expression and copy them to a new buffer.  
  600. #
  601. proc searchFields {} {
  602.     global fieldNames
  603.     if {[catch {eval prompt {{Field name:}} "author" {Fields} $fieldNames} fld]} return
  604.     if {![string length $fld]} return
  605.  
  606.     if {[catch {prompt "Regular expression:" ""} reg]} return
  607.     if {![string length $reg]} return
  608.  
  609.     set matches [findEntries $reg]
  610.     if {[llength $matches] == 0} {
  611.         return "No matching entries were found"
  612.     }
  613.     
  614.     set vals {}
  615.     foreach hit $matches {
  616.         set pos [lindex $hit 1]
  617.         set top [lindex $hit 2] 
  618.         set bottom [lindex $hit 3]
  619.         while {[set failure [expr {[getFldName $pos $top] != $fld}]]  && 
  620.             ![catch {search -f 1 -r 1 -i 1 -m 0 -l $bottom -s -- $reg $pos} mtch]} {
  621.             set pos [lindex $mtch 1]
  622.         }
  623.         if {!$failure} { lappend vals [list $top $bottom] }
  624.     }
  625.     
  626.     if {[llength $vals] >0} {
  627.         writeEntries $vals 0
  628.     } else {
  629.         message "No matching entries were found"
  630.     }
  631.     
  632. }
  633.  
  634. ###########################################################################
  635. # Sort all of the entries based on one of various criteria.
  636. #
  637. proc bibSortProc {menu item} {
  638.     if {$item == "citeKey"} {
  639.         sortByCiteKey
  640.     } elseif  {$item == "firstAuthor,Year"} {
  641.         sortByAuthors 0 0
  642.     } elseif  {$item == "lastAuthor,Year"} {
  643.         sortByAuthors 1 0
  644.     } elseif  {$item == "year,FirstAuthor"} {
  645.         sortByAuthors 0 1
  646.     } elseif  {$item == "year,LastAuthor"} {
  647.         sortByAuthors 1 1
  648.     }
  649. }
  650.  
  651. ###########################################################################
  652. # Sort the file marks. (These operations are also available under the
  653. # "Search:NamedMarks" menu)
  654. #
  655. proc markSortProc {menu item} {
  656.     if {$item == "alphabetically"} {
  657.         sortMarksFile
  658.     } elseif  {$item == "byPosition"} {
  659.         orderMarks
  660.     }
  661. }
  662.  
  663. ###########################################################################
  664. # Sort all of the entries in the file alphabetically by author.
  665. #
  666. proc sortByAuthors {{lastAuthorFirst 0} {yearFirst 0}} {
  667.     global bibTopPat bibTopPat1 bibTopPat2 BibmodeVars
  668.     set bibSegStr $BibmodeVars(segregateStrings)
  669.     
  670.     set matches [findEntries $bibTopPat]
  671.     set crossrefs [listCrossrefs]
  672.     set strings [listStrings]
  673.     
  674.     set vals {}
  675.     set others {}
  676.     set refs {}
  677.     set strs {}
  678.     
  679.     set beg [maxPos]
  680.     set end 0
  681.     
  682.     foreach hit $matches {
  683.         set pos [lindex $hit 1]
  684.         set top [lindex $hit 2] 
  685.         set bottom [lindex $hit 3]
  686.         set entry [getText $top $bottom]
  687.         regsub -all "¥[¥n¥r¥]+" $entry { } entry
  688.         regsub -all "¥[     ¥]¥[     ¥]+" $entry { } entry
  689.         regsub {[,     ]*[¥)¥}][     ]*$} $entry { } entry
  690.         if {[regexp $bibTopPat1 $entry allofit citeKey]} {
  691.             set citeKey [string tolower $citeKey]
  692.             set keyExists 1
  693.         } else {
  694.             set citekey ""
  695.             set keyExists 0
  696.         }
  697.         
  698.         if {$keyExists && [lsearch -exact $crossrefs $citeKey] >= 0} {
  699.             lappend refs [list $pos $top $bottom]
  700.         } elseif {$bibSegStr && $keyExists && [lsearch -exact $strings $citeKey] >= 0} {
  701.             lappend strs [list $citeKey $top $bottom]        
  702.         } else {
  703.             if {![catch {getFldValue $entry author} fldval]} {
  704.                 if {[catch {getFldValue $entry year} year]} { set year 9999 }
  705.                 lappend vals [list [authSortKey $fldval $lastAuthorFirst $year $yearFirst] $top $bottom]
  706.             } else {
  707.                 lappend others [list $pos $top $bottom]
  708.             }
  709.         }
  710.         if {$top < $beg} {set beg $top}
  711.         if {$bottom > $end} {set end $bottom}
  712.     }
  713.     
  714.     if {$bibSegStr} {
  715.         set result [concat $strs $others [lsort $vals] $refs]
  716.     } else {
  717.         set result [concat $others [lsort $vals] $refs]
  718.     }
  719.     
  720.     if {[llength $result] >0} {
  721.         writeEntries $result 1 $beg $end
  722.     } else {
  723.         message "No results of author sort !!??"
  724.     }
  725. }
  726.  
  727. ###########################################################################
  728. # Return a list of the cite-keys of all cross-referenced entries.
  729. #
  730. proc listStrings {} {
  731.     global bibTopPat bibTopPat1 bibTopPat2
  732.     set matches [findEntries {^[    ]*@string *[¥{¥(]} 0]
  733.  
  734.     message "scanning for @stringsﾉ"
  735.     foreach hit $matches {
  736.         set top [lindex $hit 2] 
  737.         set bottom [lindex $hit 3]
  738.         set entry [getText $top $bottom]
  739.         regsub -all "¥[¥n¥r¥]+" $entry { } entry
  740.         regsub -all "¥[     ¥]¥[     ¥]+" $entry { } entry
  741.         regsub {[,     ]*[¥)¥}][     ]*$} $entry { } entry
  742.         regexp $bibTopPat1 $entry allofit citekey
  743.         set citekey [string tolower $citekey]
  744.         if {[catch {incr strings($citekey)} num]} {
  745.             set strings($citekey) 1
  746.         }
  747.     }
  748.     if {[catch {lsort [array names strings]} res]} {
  749.         set res {}
  750.     }
  751.     message ""
  752.     return $res
  753. }
  754.  
  755. ###########################################################################
  756. # Return a list of the cite-keys of all cross-referenced entries.
  757. #
  758. proc listCrossrefs {} {
  759.     set matches [findEntries {crossref}]
  760.     catch {unset crossrefs}
  761.  
  762.     message "scanning for crossrefsﾉ"
  763.     foreach hit $matches {
  764.         set top [lindex $hit 2] 
  765.         set bottom [lindex $hit 3]
  766.         set entry [getText $top $bottom]
  767.         regsub -all "¥[¥n¥r¥]+" $entry { } entry
  768.         regsub -all "¥[     ¥]¥[     ¥]+" $entry { } entry
  769.         regsub {[,     ]*[¥)¥}][     ]*$} $entry { } entry
  770.         if {![catch {getFldValue $entry crossref} fldval]} {
  771.             set fldval [string tolower $fldval]
  772.             if {[catch {incr crossref($fldval)} num]} {
  773.                 set crossrefs($fldval) 1
  774.             }
  775.         }
  776.     }
  777.     if {[catch {lsort [array names crossrefs]} res]} {
  778.         set res {}
  779.     }
  780.     message ""
  781.     return $res
  782. }
  783.  
  784. ###########################################################################
  785. # Create a sort key from an author list.  When sorting entries by author, 
  786. # performing the sort using keys should be faster than reparsing the author 
  787. # lists for every comparison (the old method :-( ).
  788. #
  789. proc authSortKey {authList lastAuthorFirst {year {}} {yearFirst 0}} {
  790.     global BibmodeVars
  791.     set pat1 {¥¥.¥{([A-Za-z])¥}}
  792.     set pat2 {¥{([^¥{¥}]+) ([^¥{¥}]+)¥}}
  793.  
  794. # Remove enclosing braces, quotes, or whitespace
  795.     set auths %[string trim $authList {{}"     }]&
  796. # Remove TeX codes for accented characters
  797.     regsub -all $pat1 $auths {¥1} auths
  798. # Concatenate strings enclosed in braces
  799.     while {[regsub -all $pat2 $auths {{¥1¥2}} auths]} {}
  800. # Remove braces (curly and square)
  801.     regsub -all {[][¥{¥}]} $auths {} auths
  802. #    regsub -all {,} $auths { ,} auths
  803. # Replace 'and's with begin-name/end-name delimiters
  804.     regsub -all {[     ]and[     ]} $auths { ¥&% } auths
  805. # Put last name first in name fields without commas
  806.     regsub -all {%([^¥&,]+) ([^¥&, ]+) *¥&} $auths {%¥2,¥1¥&} auths
  807. # Remove begin-name delimiters
  808.     regsub -all {%} $auths {} auths
  809. # Remove whitespace surrounding name separators
  810.     regsub -all {[     ]*¥&[     ]*} $auths {¥&} auths
  811. # Replace whitespace separating words with shrieks 
  812.     regsub -all {[     ,]+} $auths {!} auths
  813. # If desired, move last author to head of sort key
  814.     if {$lastAuthorFirst} {
  815.         regsub {(.*)&([^&]+)&?$} $auths {¥2¥&¥1} auths
  816.     }
  817. # If provided, sort by year (descending order) as well
  818.     regsub {^[^0-9]*([0-9]*).*$} $year {¥1} year
  819.     if {$year != {}} {
  820.         if {$BibmodeVars(descendingYears)} { catch {set year [expr 9999-$year]} }
  821.         if {$yearFirst} {
  822.             set auths "$year&$auths"
  823.         } else {        
  824.             regsub {^([^&]+)(&?)} $auths "¥¥1¥¥&${year}¥¥2" auths
  825.         }
  826.     }
  827.         
  828.     return $auths
  829. }
  830.  
  831. ###########################################################################
  832. # Sort all of the entries in the file alphabetically by their cite-keys.
  833. #
  834. proc sortByCiteKey {} {
  835.     global bibTopPat bibTopPat1 bibTopPat2 BibmodeVars
  836.     set bibSegStr $BibmodeVars(segregateStrings)
  837.     
  838.     set matches [findEntries $bibTopPat]
  839.     set crossrefs [listCrossrefs]
  840.     set strings [listStrings]
  841.  
  842.     set begEntries [maxPos]
  843.     set endEntries 0
  844.     
  845.     set strs {}
  846.     set vals {}
  847.     set refs {}
  848.         
  849.     foreach hit $matches {
  850.         set beg [lindex $hit 0]
  851.         set end [lindex $hit 1]
  852.         set top [lindex $hit 2] 
  853.         set bottom [lindex $hit 3]
  854.         if {[regexp $bibTopPat1 [getText $top $bottom] allofit citekey]} {
  855.             set citekey [string tolower $citekey]
  856.             set keyExists 1
  857.         } else {
  858.             set citekey "000000$beg"
  859.             set keyExists 0
  860.         }
  861.         
  862.         if {$keyExists && [lsearch -exact $crossrefs $citekey] >= 0} {
  863.             lappend refs [list $top $top $bottom]
  864.         } elseif {$keyExists && $bibSegStr && [lsearch -exact $strings $citekey] >= 0} {
  865.             lappend strs [list $citekey $top $bottom]        
  866.         } else {
  867.             lappend vals [list $citekey $top $bottom]
  868.         }
  869.  
  870.         if {$top < $begEntries} {set begEntries $top}
  871.         if {$bottom > $endEntries} {set endEntries $bottom}
  872.     }
  873.  
  874.     if {$bibSegStr} {
  875.         set result [concat $strs [lsort $vals] $refs]
  876.     } else {
  877.         set result [concat [lsort $vals] $refs]
  878.     }
  879.     
  880.     if {[llength $result] >0} {
  881.         writeEntries $result 1 $begEntries $endEntries
  882.     } else {
  883.         message "No results of cite-key sort !!??"
  884.     }
  885. }
  886.  
  887. ###########################################################################
  888. # Search for all entries matching a given regular expression.  The results
  889. # are returned in a list, each element of which is a list of four integers:
  890. # the beginning and end of the matching entry and the beginning and end of
  891. # the matching string.  Adapted from "matchingLines" in "misc.tcl".
  892. #
  893. proc findEntries {reg {casesen 1}} {
  894.     if {![string length $reg]} return
  895.     
  896.     set pos 0   
  897.     set result {}                             
  898.     while {![catch {search -f 1 -r 1 -m 0 -i $casesen -s $reg $pos} mtch]} {
  899.         set entry [getEntry [lindex $mtch 0]]
  900.         lappend result [concat $mtch $entry]
  901.         set pos [lindex $entry 1]
  902.     }
  903.     return $result
  904. }
  905.  
  906. ###########################################################################
  907. #  Return a list containing the data for the current entry, indexed by
  908. #  the parameter names, e.g., "author", "year", etc.  Index names for the 
  909. #  entry type and cite-key are "type" and "citekey". 
  910. #
  911. proc getFields {pos} {
  912.      global bibTopPat bibTopPat1 bibTopPat2 bibTopPat3
  913.     set fldPat {[     ]*([a-zA-Z]+)[     ]*=[     ]*}
  914.  
  915.     set limits [getEntry $pos]
  916.     set top [lindex $limits 0]
  917.     set bottom [lindex $limits 1]
  918.     
  919.     set entry [getText $top $bottom]
  920.     regsub -all "¥[¥n¥r¥]+" $entry { } entry
  921.     regsub -all "¥[     ¥]¥[     ¥]+" $entry { } entry
  922. #
  923.     regsub {[,     ]*[¥)¥}][     ]*$} $entry { } entry
  924.  
  925.     if {[regexp -indices $bibTopPat2 $entry mtch theType theKey ]} {
  926.         set key [string range $entry [lindex $theKey 0] [lindex $theKey 1]]
  927.         set theRest [expr 1 + [lindex $mtch 1]]
  928.     } elseif {[regexp -indices $bibTopPat3 $entry mtch theType aField]} {
  929.         set key {}
  930.         set theRest [lindex $aField 0]
  931.     } else {
  932.         error "Invalid entry"
  933.     }
  934.     lappend names type
  935.     set type [string tolower [string range $entry [lindex $theType 0] [lindex $theType 1]]]
  936.     lappend data [list $type]
  937.  
  938.     lappend names citekey
  939.     lappend data $key
  940.     
  941.     set entry ",[string range $entry $theRest end]"
  942.     set fldPat {,[     ]*([^ =,]+)[     ]*=[     ]*}
  943.     set name {}
  944.     while {[regexp -indices $fldPat $entry mtch sub1]} {
  945.         set nextName [string range $entry [lindex $sub1 0] [lindex $sub1 1]]
  946.         lappend names [string tolower $nextName]
  947.         if {$name != ""} { 
  948.             set prevData [string range $entry 0 [expr [lindex $mtch 0]-1]]
  949.             lappend data [breakIntoLines [bibFieldData $prevData]]
  950.         }    
  951.         set name $nextName
  952.         set entry [string range $entry [expr [lindex $mtch 1]+1] end]
  953.     }
  954.  
  955.     lappend data [breakIntoLines [bibFieldData $entry]]
  956.     
  957.     return [list $names $data]
  958. }
  959.  
  960. proc bibFieldData {text} {
  961.     set text [string trim $text {     ,#}]
  962.     set text1 [string trim $text {¥{¥}¥"     }]            
  963.     
  964.     if {[string match {*[¥{¥}¥"]*} $text1]} {
  965.         set words [parseWords $text]
  966.         if {[llength $words]==1} {
  967.             regsub {^[¥{¥"¥']} $text {} text
  968.             regsub {[¥}¥"¥']$} $text {} text
  969.         }
  970.     } else {
  971.         set text $text1            
  972.     }
  973.     return $text
  974. }
  975.  
  976.  
  977. ###########################################################################
  978. # Extract the data from the indicated field of an entry, which is passed 
  979. # as a single string.  This version tries to be completely general, 
  980. # allowing nested braces within data fields and ignoring escaped 
  981. # delimiters.  (derived from proc getField).
  982. #
  983. proc getFldValue {entry fldname} {
  984.     set fldPat "¥[     ¥]*${fldname}¥[     ¥]*=¥[     ¥]*"
  985.     set fldPat2 {,[     ]*([^ =,]+)[     ]*=[     ]*}
  986.     set slash "¥¥"
  987.     set qslash "¥¥¥¥"
  988.     
  989.     set ok [regexp -indices -nocase $fldPat $entry mtch]
  990.     if {$ok} {
  991.         set pos [expr [lindex $mtch 1] + 1]
  992.         set entry [string range $entry $pos end]
  993.         
  994.         if {[regexp -indices $fldPat2 $entry mtch sub1]} {
  995.             set entry [string range $entry 0 [expr [lindex $mtch 0]-1]]
  996.         } 
  997.         set fld [bibFieldData $entry]
  998.         
  999.         return $fld
  1000.         
  1001.     } else {
  1002.         error "field not found"
  1003.     }
  1004. }
  1005.  
  1006. ###########################################################################
  1007. # Parse the entry around position "pos" and rewrite it to the original 
  1008. # buffer in a canonical format
  1009. #
  1010. proc formatEntry {} {
  1011.     global useBrace bibOpenQuote bibCloseQuote 
  1012.     global bibOpenEntry bibCloseEntry bibIndent
  1013.     set spc "                           "
  1014.     
  1015.     bibFormatSetup
  1016.     
  1017.     set pos [getPos]
  1018.     set limits [getEntry $pos]
  1019.     set top [lindex $limits 0]
  1020.     set bottom [lindex $limits 1]
  1021.     
  1022.     if {![catch {bibFormatEntry $pos} result]} {
  1023.         set oldEntry [getText $top $bottom]
  1024.         if {$result != $oldEntry} {
  1025.             deleteText $top $bottom 
  1026.             insertText $result
  1027.         } 
  1028.         goto $top 
  1029.         nextEntry
  1030.     } else {
  1031.         message "Couldn't format this entry for some reason"
  1032.     }
  1033. }
  1034.  
  1035. ###########################################################################
  1036. # Parse the entry around position "pos" and rewrite it to the original 
  1037. # buffer in a canonical format
  1038. #
  1039. proc formatAllEntries {} {
  1040.     global useBrace bibOpenQuote bibCloseQuote 
  1041.     global bibOpenEntry bibCloseEntry bibIndent
  1042.     set spc "                           "
  1043.     
  1044.     bibFormatSetup
  1045.     
  1046.     # This little dance handles the case that the first 
  1047.     # entry starts on the first line
  1048.     #
  1049.     set hit [getEntry [getPos]]
  1050.     if {[lindex $hit 0] == [lindex $hit 1]} {
  1051.         nextEntry
  1052.         set hit [getEntry [getPos]]
  1053.     }
  1054.     
  1055.     while {[getPos] < [lindex $hit 1]} {
  1056.         set top [lindex $hit 0] 
  1057.         set bottom [lindex $hit 1]
  1058.         
  1059.         if {![catch {bibFormatEntry $top} result]} {
  1060.             set oldEntry [getText $top $bottom]
  1061.             if {$result != $oldEntry} {
  1062.                 deleteText $top $bottom 
  1063.                 insertText $result
  1064.             } 
  1065.         }
  1066.         goto $top
  1067.         nextEntry
  1068.         set hit [getEntry [getPos]]
  1069.     }
  1070. }
  1071.  
  1072. ###########################################################################
  1073. # Parse the entry around position "pos" and rewrite it in a canonical format.
  1074. # The formatted entry is returned.
  1075. #
  1076. proc bibFormatEntry {pos} {
  1077.     global useBrace bibOpenQuote bibCloseQuote 
  1078.     global bibOpenEntry bibCloseEntry bibIndent
  1079.     global rqdFld optFld BibmodeVars bibAbbrevs
  1080.     set spc "                           "
  1081.     #    
  1082.     #    note: calling proc must call "bibFormatSetup" before calling "bibFormatEntry"
  1083.     #
  1084.     set limits [getEntry $pos]
  1085.     set top [lindex $limits 0]
  1086.     set bottom [lindex $limits 1]
  1087.  
  1088.     if {[catch {getFields $pos} flds]} {
  1089.         error "bibFormatEntry: Getflds couldn't find any"
  1090.     }
  1091.     
  1092.     set names [lindex $flds 0]
  1093.     set vals [lindex $flds 1]
  1094.     set nfld [llength $names]
  1095.     
  1096.     set type [string tolower [lindex $vals 0]]
  1097.     set citekey [lindex $vals 1]
  1098. #     message "$citekey"
  1099.     # Don't process @string entries
  1100.     if {$type == "string"} {
  1101.         set lines [getText $top $bottom]
  1102.         return $lines
  1103.     }
  1104.     # Find length of longest field name
  1105.     set nmlen 0
  1106.     foreach nm $names {
  1107.         set len [string length $nm]
  1108.         if {$len > $nmlen} { set nmlen $len }
  1109.         if {![info exists useBrace($nm)]} { set useBrace($nm) 0 }
  1110.     }
  1111.     
  1112.     # Format first line
  1113.     set lines "@${type}${bibOpenEntry}${citekey},¥r"
  1114.     
  1115.     # Format each field on a separate line
  1116.     for {set ifld 2} {$ifld < $nfld} {incr ifld} { 
  1117.     set nm [lindex $names $ifld]
  1118.     set vl [lindex $vals $ifld]
  1119.     if {$vl != "" || ! $BibmodeVars(zapEmptyFields) || 
  1120.             [lsearch $rqdFld($type) $nm] >= 0} {
  1121.         set pad [expr $nmlen - [string length $nm]]
  1122.         
  1123.         if {$BibmodeVars(alignEquals)} {
  1124.             set pref "${bibIndent}$nm[string range $spc 1 $pad] ="
  1125.         } else {
  1126.             set pref "${bibIndent}$nm =[string range $spc 1 $pad]"
  1127.         }
  1128.         set ind [string range $spc 1 [string length $pref]]
  1129.         
  1130.         # Delimit field, if appropriate
  1131.         set noBrace [expr ($useBrace($nm) == 0 && [isNum $vl]) || [hasCat $vl]]
  1132.         if {$noBrace == 0 && [string first " " $vl] < 0} {
  1133.             set noBrace [expr [lsearch $bibAbbrevs [string tolower $vl]] >= 0]
  1134.         }
  1135.         if {$noBrace != 0} {
  1136.             set vl "$vl,"
  1137.         } else {
  1138.             set vl "${bibOpenQuote}${vl}${bibCloseQuote},"
  1139.         }
  1140.         
  1141.         set pieces [split $vl "¥r"]
  1142.         append lines "$pref [lindex $pieces 0]¥r"
  1143.         foreach piece [lrange $pieces 1 end] {
  1144.             append lines "$ind  $piece¥r"
  1145.         }
  1146.     }
  1147. }
  1148.     append lines "$bibCloseEntry¥r"
  1149.     return $lines
  1150. }
  1151.  
  1152. ###########################################################################
  1153. # Get the name of the field that starts before the given position,  
  1154. # $pos.  The positions $top and $bottom restrict the range of the 
  1155. # search for the beginning and end of the field; typically, $top and
  1156. # $bottom will be the limits of a given entry.
  1157. #
  1158. proc getFldName {pos top} {
  1159.     set fldPat {[,     ]+([^     =,¥{¥}¥"¥']+)[     ]*=[     ]*}
  1160.     if {![catch {search -f 0 -r 1 -m 0 -i 1 -s -limit $top "$fldPat" $pos} mtch]} {
  1161.         set theText [eval getText $mtch]
  1162.         regexp -nocase $fldPat $theText allofit fldnam
  1163.         return $fldnam
  1164.     } else {
  1165.         return {citekey}
  1166.     }
  1167. }
  1168.  
  1169. ###########################################################################
  1170. #  Set the quote characters for quoted fields based on the value of the 
  1171. #  flag $bibUseBrace
  1172. # 
  1173. proc bibFieldDelims {} {
  1174.     global BibmodeVars bibOpenQuote bibCloseQuote
  1175.     if {$BibmodeVars(fieldBraces)} then {
  1176.         set bibOpenQuote "{"
  1177.         set bibCloseQuote "}" 
  1178.     } else {
  1179.         set bibOpenQuote {"} 
  1180.         set bibCloseQuote {"} 
  1181.     }
  1182. }
  1183.  
  1184. proc bibEntryDelims {} {
  1185.     global BibmodeVars bibOpenEntry bibCloseEntry
  1186.     if {$BibmodeVars(entryBraces)} then {
  1187.         set bibOpenEntry "{"
  1188.         set bibCloseEntry "}" 
  1189.     } else {
  1190.         set bibOpenEntry "("
  1191.         set bibCloseEntry ")"
  1192.     }
  1193. }
  1194.  
  1195. proc isBibFile {} {
  1196.     set fileName [car [winNames -f]]   
  1197.     set ext [file extension $fileName]
  1198.     return [string match ".bib" [string tolower $ext]] 
  1199. }
  1200.  
  1201. proc hasNumVal {str} {
  1202.     expr ! [catch {expr $str}]
  1203. }
  1204. proc isNum {str} {
  1205.     regexp {^[     ]*[0-9]+[     ]*$} $str mtch
  1206. }
  1207. proc hasCat {str} {
  1208.     regexp {¥#} $str mtch
  1209. }
  1210.  
  1211. ###########################################################################
  1212. # Take a list of lists that point to selected entries and copy these into
  1213. # a new window.  The beginning and ending positions for each entry must 
  1214. # be the last two items in each sublist.  The rest of the sublists are
  1215. # ignored.  It is assumed that each sublist has the same number of items.
  1216. #
  1217. proc writeEntries {entryPos nondestructive {beg {0}} {end {-1}}} {
  1218.         global BibmodeVars
  1219.         if {$end < 0} {set end [maxPos]}
  1220.         set llen [expr [llength [lindex $entryPos 0]] - 1]
  1221.         set llen1 [expr $llen-1]
  1222.         foreach entry $entryPos {
  1223.             set limits [lrange $entry $llen1 $llen]
  1224.             append lines [eval getText $limits]
  1225.         }
  1226.         set overwriteOK [expr $nondestructive || ! [isBibFile]]
  1227.         if {$BibmodeVars(overwriteBuffer) && $overwriteOK} {
  1228.             deleteText $beg $end
  1229.             insertText $lines
  1230.             goto $beg
  1231.         } else {
  1232.             set begLines [getText 0 [lineStart $beg]]
  1233.             set endLines [getText [nextLineStart $end] [maxPos]]
  1234.             new -n {*BibTeX Sort/Search*}
  1235.             newMode Bib
  1236.             insertText $begLines
  1237.             insertText $lines
  1238.             insertText $endLines
  1239.             goto $beg
  1240.             setWinInfo dirty 0
  1241.             catch shrinkWindow
  1242.         }
  1243. }
  1244.  
  1245. ###########################################################################
  1246. # Set a named mark for each entry, using the cite-key name
  1247. #
  1248. proc BibMarkFile {} {
  1249.     global BibmodeVars
  1250.      global bibTopPat bibTopPat1 bibTopPat2
  1251.     set pos 0
  1252.     while {![catch {search -f 1 -r 1 -m 0 -i 0 -s $bibTopPat1 $pos} res]} {
  1253.         set start [lindex $res 0]
  1254.         set end [nextLineStart $start]
  1255.         set text [getText $start $end]
  1256.         set lab ""
  1257.         if {[regexp $bibTopPat2 $text mtch type citekey]} {
  1258.             if {[string tolower $type] != "string" || $BibmodeVars(markStrings)} { 
  1259.                 setNamedMark $citekey [lineStart [expr $start - 1]] $start $start
  1260.             }
  1261.         }
  1262.         set pos $end
  1263.     }
  1264. }
  1265.  
  1266. ###########################################################################
  1267. # Report the number of entries of each type
  1268. #
  1269. proc countEntries {} {
  1270.     global entryNames
  1271.      global bibTopPat bibTopPat1 bibTopPat2
  1272.     
  1273.     set pos 0
  1274.     set count 0
  1275.     catch {unset type}
  1276.     
  1277.     while {![catch {search -f 1 -r 1 -m 0 -i 0 -s $bibTopPat $pos} res]} {
  1278.         incr count
  1279.         set start [lindex $res 0]
  1280.         set end [nextLineStart $start]
  1281.         set text [getText $start $end]
  1282.         set lab ""
  1283.         if {[regexp $bibTopPat $text mtch entryType]} {
  1284.             set entryType [string tolower $entryType]
  1285.             if {[catch {incr type($entryType)} num]} {
  1286.                 set type($entryType) 1
  1287.             }
  1288.         }
  1289.         set pos $end
  1290.     }
  1291.     new -n {*BibTeX Statistics*}
  1292.     newMode Bib
  1293.     foreach name [lsort [array names type]] {
  1294.         if {$type($name) > 0} {
  1295.             append lines [format "%4.0d  %s¥n" $type($name) $name]
  1296.         }
  1297.     }
  1298.     append lines "----  -----------------¥n"
  1299.     append lines [format "%4.0d  %s¥n" $count "Total entries"]
  1300.     insertText $lines
  1301.     goto 0
  1302.     setWinInfo dirty 0
  1303.     catch {shrinkWindow 1}
  1304. }
  1305. #--------------------------------------------------------------------------
  1306. # command-double-clicking:
  1307. #--------------------------------------------------------------------------
  1308.  
  1309. ###########################################################################
  1310. # In Bib mode, Cmd-double-clicks resolve abbrevs and cross-refs
  1311. #
  1312. proc BibDblClick {from to} {
  1313.     global bibTopPat bibTopPat1 bibTopPat2
  1314.     
  1315.     set limits [getEntry $from]
  1316.     set top [lindex $limits 0]
  1317.     set bottom [lindex $limits 1]
  1318.  
  1319.     # Extend selection to largest string that could be an entry reference
  1320.     set text [string trim [eval getText [BibExtendClick $from $to $top $bottom]]]
  1321.     
  1322.     # Get the citekey of current entry, so we can avoid jumping to it    
  1323.     set citekey {}
  1324.     regexp $bibTopPat2 [getText $top $bottom] mtch type citekey ]
  1325.     set fldName [getFldName $from $top]
  1326.  
  1327.     if {[string length $text] == 0 || $text == $citekey || $fldName == $text || 
  1328.         ($fldName == "citekey" && [string tolower $type] != "string")} {
  1329.         message "Command-double-click on abbreviations and crossref arguments"
  1330.         return
  1331.     }
  1332.  
  1333.     # Jump to the mark for the specified citation, if a mark exists...
  1334.     # ...otherwise, do an ordinary search for the cite key
  1335.     pushMark    
  1336.     set searchPat "$bibTopPat¥[     ¥]*[quoteExpr $text]¥[     ,¥}¥)¥]"
  1337.     if {![catch {search -f 1 -r 1 -i 1 -m 0 $searchPat 0} mtch]} {
  1338.         goto [lindex $mtch 0]
  1339.     } else {
  1340.         popMark
  1341.         select $from $to
  1342.         if {$fldName == "crossref"} {
  1343.             message "Cross-reference ¥"$text¥" not found"
  1344.         } else {
  1345.             message "Command-double-click on abbreviations and crossref arguments"
  1346.         }
  1347.         return
  1348.     }
  1349.     message "Use Ctl-. to return to original position"
  1350.     return
  1351. }
  1352.  
  1353. # Extend the selection around the initial selection {$from,$to}
  1354. # Extension is restricted to the range {$top,$bottom} (the current entry)
  1355. proc BibExtendClick {from to top bottom} {
  1356.     if {$to == 0} { set to $from }
  1357.     set result [list $from $to]
  1358.     if {![catch {search -f 0 -r 1 -s -m 0 -l $top "¥[,¥{¥]¥"¥'=" $from} mtch0]} {
  1359.         if {![catch {search -f 1 -r 1 -s -m 0 -l $bottom "¥[,¥}¥]¥"¥'=" $to} mtch1]} {
  1360.             set from [lindex $mtch0 1]
  1361.             set to [lindex $mtch1 0]
  1362.             # Check for illegal chars embedded in the selection
  1363.             if {[regexp "¥[¥{¥}¥]=" [getText $from $to]] == 0} {
  1364.                 set result [list $from $to]
  1365.             }
  1366.         }
  1367.     }
  1368.     return $result
  1369. }
  1370.  
  1371.  
  1372. ###########################################################################
  1373.  
  1374. proc dummyBibTeX {} {
  1375.     global BibmodeVars TeXmodeVars
  1376. #     if {$BibmodeVars(convert8bitAscii2TeX) != $TeXmodeVars(convert8bitAscii2TeX)} {
  1377. #         set BibmodeVars(convert8bitAscii2TeX) $TeXmodeVars(convert8bitAscii2TeX)
  1378. #     }    
  1379. }
  1380.  
  1381. #
  1382.  
  1383. #===============================================================================
  1384. proc pcite {} {
  1385.     set words [getline "Citation keys" ""]
  1386.     if {![llength $words]} {error "No keys"}
  1387.     
  1388.     set pattern {@}
  1389.     foreach w $words {
  1390.         append pattern "(¥[^@¥]+$w)"
  1391.     }
  1392.     
  1393.     foreach entry [findEntries $pattern] {
  1394.         set res [getFields [car $entry]]
  1395.         set title [lindex [cadr $res] [lsearch [car $res] "title"]]
  1396.         set citekey [lindex [cadr $res] [lsearch [car $res] "citekey"]]
  1397.         set matches($title) $citekey
  1398.         set where($title) [car $entry]
  1399.     }
  1400.     if {![info exists matches]} {alertnote "No citations"; return}
  1401.     set title [listpick -p "Citation?" [lsort [array names matches]]]
  1402.     putScrap $matches($title)
  1403.     alertnote $matches($title)
  1404.     goto $where($title)
  1405. }
  1406.